home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / program / 619 / tunes / tunes.lst < prev    next >
Encoding:
File List  |  1992-08-05  |  37.2 KB  |  1,617 lines

  1. '
  2. ' TUNES v1.0
  3. ' by Harry Sarber
  4. ' Started: 11/30/90
  5. '
  6. @init
  7. @doit
  8. @gone
  9. '
  10. ' *******************
  11. '
  12. PROCEDURE init
  13.   ON ERROR GOSUB err_handler
  14.   prn$="init"
  15.   last_filename$=""
  16.   CLS
  17.   v_rez%=CARD{L~A-4}
  18.   h_rez%=CARD{L~A-12}
  19.   IF v_rez%>200
  20.     bell
  21.     ALERT 3," |This program only runs|  on color systems!",1,"Ok",void%
  22.     END
  23.   ELSE
  24.     IF h_rez%>320
  25.       rez%=1
  26.     ELSE
  27.       rez%=0
  28.     ENDIF
  29.   ENDIF
  30.   version$="1.0"
  31.   rev_date$="08/05/92"
  32.   @keep_colors
  33.   FOR i%=0 TO 15
  34.     SETCOLOR i%,0,0,0
  35.   NEXT i%
  36.   DIM sa%(16)
  37.   DIM c%(16,3)
  38.   DIM d%(3)
  39.   DIM s%(24,2)
  40.   max_notes%=64
  41.   DIM voice%(3,max_notes%,8)
  42.   DIM m$(3,15)
  43.   DIM mline$(3)
  44.   DIM spd%(12)
  45.   DIM sfn$(3,2)
  46.   DIM menu_bar$(50)
  47.   DIM letters$(24)
  48.   RESTORE letter_data
  49.   FOR i%=0 TO 23
  50.     READ l$
  51.     LET letters$(i%)=l$
  52.   NEXT i%
  53. letter_data:
  54.   DATA A,G,F,E,D,C,B,A,G,F,E,D,C,B,A,G,F,E,D,C,B,A,G,F
  55.   RESTORE speed_data
  56.   FOR i%=0 TO 11
  57.     READ spd%
  58.     spd%(i%)=spd%
  59.   NEXT i%
  60. speed_data:
  61.   DATA 128,64,32,16,8,4,128,64,32,16,8,4
  62.   @question
  63.   @stopsign
  64.   @exclamation
  65.   currentdrive%=GEMDOS(&H19)
  66.   currentpath$=CHR$(ASC("A")+GEMDOS(&H19))+":"+DIR$(0)+"\"
  67.   LET data_path$=currentpath$
  68.   IF EXIST("TUNES.PI1")
  69.     IF rez%=1
  70.       VOID XBIOS(5,L:-1,L:-1,W:0)
  71.     ENDIF
  72.     degas_load("TUNES.PI1")
  73.     a%=XBIOS(2)-32
  74.     FOR i%=0 TO 15                        ! Convert Degas colors into
  75.       c%(i%,0)=INT(DPEEK(a%)/256)         ! separate colors in array c%()
  76.       c%(i%,1)=INT((DPEEK(a%) MOD 256)/16)! for use with Setcolor command.
  77.       c%(i%,2)=DPEEK(a%) MOD 16
  78.       a%=a%+2
  79.     NEXT i%
  80.     x1=18
  81.     y1=159
  82.     x2=301
  83.     y2=y1+18
  84.     GET x1,y1,x2,y2,tmp$
  85.     DEFFILL 0,1,1
  86.     PBOX x1,y1,x2,y2
  87.     GET x1-7,y1-7,x2+7,y1,up$
  88.     GET x1-7,y1,x2+7,y2,md$
  89.     PUT x1,y1,tmp$
  90.   ELSE
  91.     SETCOLOR 0,7,7,7
  92.     FOR i%=1 TO 15
  93.       SETCOLOR i%,0,0,0
  94.     NEXT i%
  95.     bell
  96.     IF rez%=1                             ! Reset to medium rez if necessary.
  97.       VOID XBIOS(5,L:-1,L:-1,W:rez%)
  98.     ENDIF
  99.     ALERT 3,"I cannot find TUNES.PI1!| |   It must be in the|      same path.",1," Bye ",void%
  100.     gone
  101.   ENDIF
  102.   work_note%=1
  103.   last_note%=1
  104.   men_num%=1
  105.   xf=19
  106.   sx1%=28
  107.   sy1%=89
  108.   sx2%=304
  109.   sy2%=136
  110.   x1=18
  111.   y1=159
  112.   x2=301
  113.   y2=y1+18
  114.   FOR j%=1 TO 3
  115.     GET x1,y1-40+((j%-1)*20),x2,y2-40+((j%-1)*20),mline$(j%-1)
  116.     FOR i%=1 TO 15
  117.       IF i%>0 AND i%<13
  118.         GET x1+((i%-1)*19)+3,y1+1-40+((j%-1)*20),x1+(i%*19)-3,y2-1-40+((j%-1)*20),m$(j%-1,i%-1)
  119.       ELSE
  120.         IF i%>12 AND i%<14
  121.         ELSE
  122.           IF i%>13 AND i%<16
  123.             GET x1+((i%-1)*19)+7,y1+4-40+((j%-1)*20),x1+(i%*19)-6,y2-4-40+((j%-1)*20),sfn$(j%-1,i%-14)
  124.           ENDIF
  125.         ENDIF
  126.       ENDIF
  127.     NEXT i%
  128.   NEXT j%
  129.   '
  130.   GRAPHMODE 2
  131.   DEFTEXT 1,,,4
  132.   TEXT 195,34,version$
  133.   GET 10,63,308,111,whole_staff$
  134.   GET 11,112,308,119,top_line$
  135.   DEFFILL 0,1,1
  136.   PBOX 10,63,308,y1-1
  137.   PUT 11,y1-7,top_line$
  138.   DEFFILL 8,1,1
  139.   FILL x1+279,y1+2
  140.   FILL x1+275,y1+10
  141.   PUT 10,sy1%-2,whole_staff$
  142.   GET sx1%,sy1%-13,sx1%+18,sy2%+1,blank_staff$
  143.   GET 83,28,95,32,knob$
  144.   GET 225,13,237,45,bar$
  145.   PUT 83,14,bar$
  146.   GET 120,45,122,51,slider_knob$
  147.   GET 123,45,125,51,slider_bar$
  148.   PUT 120,45,slider_bar$
  149.   GET 120,45,199,51,slider_bar$
  150.   DEFFILL 0,1,1
  151.   GET 271,6,312,16,blank_note1$
  152.   GET 271,16,312,26,blank_note2$
  153.   DEFTEXT 4,,,6
  154.   TEXT 275,15,"Note"
  155.   GET 245,32,312,51,blank_voice$
  156.   @build_menu_bar
  157.   vol%=15
  158.   @show_volume_bar
  159.   spd%=8
  160.   @show_speed_bar
  161.   vn%=1
  162.   @show_voice(vn%)
  163.   new_offset%=0
  164.   @show_note_bar
  165.   note$=m$(vn%-1,0)
  166.   GET 240,8,246,14,blank_ext$
  167.   @show_work_note
  168.   @set_sound_data
  169.   '
  170.   rate%=20                              ! Rate of Fade-In/Fade-Out
  171.   '
  172.   @fadein
  173. RETURN
  174. PROCEDURE doit
  175.   prn$="doit"
  176.   last_filename$=""
  177.   SGET screen$
  178.   hidden!=FALSE
  179.   flat!=FALSE
  180.   sharp!=FALSE
  181.   dotted!=FALSE
  182.   @hide_mouse
  183.   filename$=data_path$+"TUNES.TUN"
  184.   startup!=TRUE
  185.   ld_it
  186.   startup!=FALSE
  187.   SGET mscreen$
  188.   DO
  189.     @get_mouse
  190.     @check_right_button
  191.     @check_y
  192.     @check_left_button
  193.   LOOP
  194. RETURN
  195. PROCEDURE gone
  196.   prn$="gone"
  197.   last_filename$=""
  198.   CLS
  199.   IF rez%=1
  200.     VOID XBIOS(5,L:-1,L:-1,W:rez%)
  201.   ENDIF
  202.   @restore_colors
  203.   EDIT
  204.   END
  205. RETURN
  206. '
  207. ' *******************
  208. '
  209. PROCEDURE get_mouse
  210.   MOUSE x%,y%,b%
  211.   IF x%>319
  212.     SUB x%,320
  213.   ENDIF
  214.   '    PRINT AT(1,23);SPACE$(20)
  215.   '    PRINT AT(1,23);x%,y%
  216. RETURN
  217. PROCEDURE check_right_button
  218.   IF b%=2
  219.     @quit
  220.     IF answer%=1
  221.       gone
  222.     ENDIF
  223.   ENDIF
  224. RETURN
  225. PROCEDURE check_y
  226.   IF y%<=sy1%
  227.     @hide_sprite
  228.     @show_mouse
  229.   ELSE
  230.     IF x%>sx1% AND x%<sx2% AND y%>sy1% AND y%<sy2%
  231.       @hide_mouse
  232.       note%=INT((x%-sx1%)/19)+1
  233.       pos%=INT((y%-sy1%)/2)+1
  234.       IF (note%<>last_note% OR pos%<>last_pos%)
  235.         SPUT mscreen$
  236.         PUT (note%-1)*19+sx1%-2,(pos%-1)*2+sy1%-14,note$,7
  237.         GRAPHMODE 1
  238.         DEFTEXT 6,,,6
  239.         IF work_note%<7
  240.           TEXT 288,23,letters$(pos%-1)
  241.           @play_note
  242.         ELSE
  243.           TEXT 288,23," "
  244.         ENDIF
  245.         sprite_hidden!=FALSE
  246.       ENDIF
  247.       IF (note%<>last_note% OR pos%<>last_pos%)
  248.         last_note%=note%
  249.         last_pos%=pos%
  250.       ENDIF
  251.     ELSE
  252.       @hide_sprite
  253.       @show_mouse
  254.     ENDIF
  255.   ENDIF
  256. RETURN
  257. PROCEDURE check_left_button
  258.   IF b%=1
  259.     @note_selected
  260.     @slider_selected
  261.     @button_selected
  262.     @menu_selected
  263.   ENDIF
  264. RETURN
  265. '
  266. ' ******************
  267. '
  268. PROCEDURE note_selected
  269.   IF x%>sx1% AND x%<sx2% AND y%>sy1% AND y%<sy2%
  270.     note_location%=INT((x%-sx1%)/19)+1
  271.     note%=INT((x%-sx1%)/19)+1+offset%
  272.     pos%=INT((y%-sy1%)/2)+1
  273.     IF voice%(vn%-1,note%-1,0)=0
  274.       IF work_note%<7
  275.         @play_note
  276.         voice%(vn%-1,note%-1,2)=s%(pos%-1,1)
  277.         IF sharp!
  278.           voice%(vn%-1,note%-1,3)=s%(pos%-1,0)+1
  279.         ELSE
  280.           IF flat!
  281.             voice%(vn%-1,note%-1,3)=s%(pos%-1,0)-1
  282.           ELSE
  283.             voice%(vn%-1,note%-1,3)=s%(pos%-1,0)
  284.           ENDIF
  285.         ENDIF
  286.         voice%(vn%-1,note%-1,4)=vol%
  287.         voice%(vn%-1,note%-1,6)=(-sharp!*1)+(-flat!*2)
  288.         voice%(vn%-1,note%-1,7)=-dotted!
  289.       ELSE
  290.         voice%(vn%-1,note%-1,2)=0
  291.         voice%(vn%-1,note%-1,3)=0
  292.         voice%(vn%-1,note%-1,4)=0
  293.         voice%(vn%-1,note%-1,6)=0
  294.         voice%(vn%-1,note%-1,7)=0
  295.       ENDIF
  296.       voice%(vn%-1,note%-1,0)=note%
  297.       voice%(vn%-1,note%-1,1)=work_note%
  298.       voice%(vn%-1,note%-1,5)=pos%
  299.       @show_notes(note%-1,note_location%-1)
  300.       REPEAT
  301.       UNTIL MOUSEK=0
  302.     ELSE
  303.       voice%(vn%-1,note%-1,0)=0
  304.       voice%(vn%-1,note%-1,1)=0
  305.       voice%(vn%-1,note%-1,2)=0
  306.       voice%(vn%-1,note%-1,3)=0
  307.       voice%(vn%-1,note%-1,4)=0
  308.       voice%(vn%-1,note%-1,5)=0
  309.       voice%(vn%-1,note%-1,6)=0
  310.       voice%(vn%-1,note%-1,7)=0
  311.       @show_notes(note%-1,note_location%-1)
  312.       REPEAT
  313.       UNTIL MOUSEK=0
  314.     ENDIF
  315.   ENDIF
  316. RETURN
  317. PROCEDURE slider_selected
  318.   IF x%>82 AND x%<96 AND y%>13 AND y%<44
  319.     @set_speed
  320.   ENDIF
  321.   IF x%>224 AND x%<237 AND y%>13 AND y%<44
  322.     @set_volume
  323.   ENDIF
  324.   IF x%>246 AND x%<312 AND y%>32 AND y%<52
  325.     @set_voice
  326.   ENDIF
  327.   PUT 247,8,note$
  328.   IF x%>119 AND x%<198 AND y%>44 AND y%<52
  329.     @do_slider
  330.   ENDIF
  331.   IF x%>103 AND x%<113 AND y%>43 AND y%<53
  332.     @move_right
  333.   ELSE
  334.     IF x%>209 AND x%<218 AND y%>43 AND y%<53
  335.       @move_left
  336.     ENDIF
  337.   ENDIF
  338. RETURN
  339. PROCEDURE button_selected
  340.   IF x%>6 AND x%<25 AND y%>6 AND y%<26
  341.     @load
  342.   ELSE
  343.     IF x%>31 AND x%<50 AND y%>6 AND y%<26
  344.       @save
  345.     ELSE
  346.       IF x%>56 AND x%<75 AND y%>6 AND y%<26
  347.         @accessories
  348.       ELSE
  349.         IF x%>6 AND x%<25 AND y%>32 AND y%<52
  350.           @write
  351.         ELSE
  352.           IF x%>31 AND x%<50 AND y%>32 AND y%<52
  353.             @play
  354.           ELSE
  355.             IF x%>56 AND x%<75 AND y%>32 AND y%<52
  356.               @reset
  357.             ENDIF
  358.           ENDIF
  359.         ENDIF
  360.       ENDIF
  361.     ENDIF
  362.   ENDIF
  363. RETURN
  364. PROCEDURE menu_selected
  365.   IF x%>=x1 AND x%<=x2 AND y%>=y1 AND y%<=y2
  366.     GRAPHMODE 1
  367.     men_num%=INT((x%-x1)/19)+1
  368.     note$=m$(vn%-1,work_note%-1)
  369.     IF men_num%>0 AND men_num%<7
  370.       work_note%=men_num%
  371.       note$=m$(vn%-1,men_num%-1)
  372.       PUT 271,6,blank_note1$
  373.       DEFTEXT 4,,,6
  374.       TEXT 275,15,"Note"
  375.       @show_work_note
  376.       @hide_mouse
  377.       SGET mscreen$
  378.       @show_mouse
  379.     ELSE
  380.       IF men_num%>6 AND men_num%<13
  381.         work_note%=men_num%
  382.         note$=m$(vn%-1,men_num%-1)
  383.         PUT 248,8,note$
  384.         PUT 271,6,blank_note1$
  385.         DEFTEXT 4,,,6
  386.         TEXT 275,15,"Rest"
  387.         @show_work_note
  388.         @hide_mouse
  389.         SGET mscreen$
  390.         @show_mouse
  391.       ELSE
  392.         IF men_num%>12 AND men_num%<14
  393.           IF dotted!
  394.             DEFFILL 0,1,1
  395.             FILL x1+241,y1+2
  396.             dotted!=FALSE
  397.             IF work_note%>0 AND work_note%<7
  398.               @show_work_note
  399.             ENDIF
  400.             @hide_mouse
  401.             SGET mscreen$
  402.             @show_mouse
  403.           ELSE
  404.             DEFFILL 8,1,1
  405.             FILL x1+241,y1+2
  406.             dotted!=TRUE
  407.             IF work_note%>0 AND work_note%<7
  408.               @show_work_note
  409.             ENDIF
  410.             @hide_mouse
  411.             SGET mscreen$
  412.             @show_mouse
  413.           ENDIF
  414.           REPEAT
  415.           UNTIL MOUSEK=0
  416.         ELSE
  417.           IF men_num%>13 AND men_num%<15
  418.             IF sharp!
  419.               sharp!=FALSE
  420.             ELSE
  421.               sharp!=TRUE
  422.               flat!=FALSE
  423.             ENDIF
  424.             @blank_sfn
  425.             @show_sfn
  426.             @show_work_note
  427.             @hide_mouse
  428.             SGET mscreen$
  429.             @show_mouse
  430.           ELSE
  431.             IF men_num%>14 AND men_num%<16
  432.               IF flat!
  433.                 flat!=FALSE
  434.               ELSE
  435.                 sharp!=FALSE
  436.                 flat!=TRUE
  437.               ENDIF
  438.               @blank_sfn
  439.               @show_sfn
  440.               @show_work_note
  441.               @hide_mouse
  442.               SGET mscreen$
  443.               @show_mouse
  444.             ENDIF
  445.           ENDIF
  446.         ENDIF
  447.       ENDIF
  448.     ENDIF
  449.     REPEAT
  450.     UNTIL MOUSEK=0
  451.   ENDIF
  452. RETURN
  453. '
  454. ' ******************
  455. '
  456. PROCEDURE hide_sprite
  457.   prn$="hide_sprite"
  458.   last_filename$=""
  459.   IF sprite_hidden!=FALSE
  460.     SPUT mscreen$
  461.     sprite_hidden!=TRUE
  462.   ENDIF
  463. RETURN
  464. PROCEDURE show_notes(which%,where%)
  465.   prn$="show_notes(which%,where%)"
  466.   last_filename$=""
  467.   PUT where%*19+sx1%-3,sy1%-13,blank_staff$
  468.   FOR j%=0 TO 2
  469.     IF voice%(j%,which%,0)<>0
  470.       PUT where%*19+sx1%-1,(voice%(j%,which%,5)-1)*2+sy1%-14,m$(j%,voice%(j%,which%,1)-1),7
  471.       IF voice%(j%,which%,6)=1
  472.         PUT where%*19+sx1%-1,(voice%(j%,which%,5)-1)*2+sy1%-14,sfn$(j%,voice%(j%,which%,6)-1),7
  473.       ELSE
  474.         IF voice%(j%,which%,6)=2
  475.           PUT where%*19+sx1%-1,(voice%(j%,which%,5)-1)*2+sy1%-14,sfn$(j%,voice%(j%,which%,6)-1),7
  476.         ENDIF
  477.       ENDIF
  478.       IF voice%(j%,which%,7)=1
  479.         GRAPHMODE 2
  480.         IF j%=0
  481.           DEFTEXT 15,,,6
  482.         ELSE
  483.           IF j%=1
  484.             DEFTEXT 14,,,6
  485.           ELSE
  486.             DEFTEXT 9,,,6
  487.           ENDIF
  488.         ENDIF
  489.         TEXT where%*19+sx1%+6,(voice%(j%,which%,5)-1)*2+sy1%+1,"."
  490.       ENDIF
  491.     ENDIF
  492.   NEXT j%
  493.   SGET mscreen$
  494. RETURN
  495. PROCEDURE blank_sfn
  496.   DEFFILL 0,1,1
  497.   FILL x1+260,y1+2
  498.   FILL x1+256,y1+10
  499.   FILL x1+279,y1+2
  500.   FILL x1+275,y1+10
  501. RETURN
  502. PROCEDURE show_sfn
  503.   prn$="show_sfn"
  504.   last_filename$=""
  505.   DEFFILL 8,1,1
  506.   IF sharp!
  507.     FILL x1+260,y1+2
  508.     FILL x1+256,y1+10
  509.   ELSE
  510.     IF flat!
  511.       FILL x1+271,y1+2
  512.       FILL x1+275,y1+10
  513.     ENDIF
  514.   ENDIF
  515. RETURN
  516. PROCEDURE play_note
  517.   prn$="play_note"
  518.   last_filename$=""
  519.   IF sharp!
  520.     SOUND vn%,vol%,s%(pos%-1,0)+1,s%(pos%-1,1),3
  521.   ELSE
  522.     IF flat!
  523.       SOUND vn%,vol%,s%(pos%-1,0)-1,s%(pos%-1,1),3
  524.     ELSE
  525.       SOUND vn%,vol%,s%(pos%-1,0),s%(pos%-1,1),3
  526.     ENDIF
  527.   ENDIF
  528.   SOUND vn%,0,0,0,0
  529. RETURN
  530. PROCEDURE show_work_note
  531.   prn$="show_work_note"
  532.   last_filename$=""
  533.   PUT 248,8,m$(vn%-1,work_note%-1)
  534.   IF work_note%<7
  535.     IF sharp!
  536.       PUT 248,8,sfn$(vn%-1,0)
  537.     ELSE
  538.       IF flat!
  539.         PUT 248,8,sfn$(vn%-1,1)
  540.       ENDIF
  541.     ENDIF
  542.     IF dotted!
  543.       GRAPHMODE 2
  544.       IF vn%=1
  545.         DEFTEXT 15,,,6
  546.       ELSE
  547.         IF vn%=2
  548.           DEFTEXT 14,,,6
  549.         ELSE
  550.           IF vn%=3
  551.             DEFTEXT 9,,,6
  552.           ENDIF
  553.         ENDIF
  554.       ENDIF
  555.       TEXT 254,23,"."
  556.     ENDIF
  557.   ENDIF
  558.   GET 247,8,260,25,note$
  559. RETURN
  560. '
  561. ' *******************
  562. '
  563. PROCEDURE set_voice
  564.   prn$="set_voice"
  565.   last_filename$=""
  566.   vn%=INT((x%-246)/25)+1
  567.   @show_voice(vn%)
  568.   REPEAT
  569.   UNTIL MOUSEK=0
  570. RETURN
  571. PROCEDURE show_voice(which_voice%)
  572.   prn$="show_voice(which_voice%)"
  573.   last_filename$=""
  574.   @hide_mouse
  575.   GRAPHMODE 1
  576.   PUT 245,32,blank_voice$
  577.   DEFFILL 2,1,1
  578.   FILL (which_voice%-1)*25+254,37
  579.   PUT x1,y1,mline$(which_voice%-1)
  580.   IF dotted!=TRUE
  581.     DEFFILL 8,1,1
  582.     FILL x1+241,y1+2
  583.   ENDIF
  584.   @show_sfn
  585.   @show_work_note
  586.   SGET mscreen$
  587.   @show_mouse
  588. RETURN
  589. '
  590. ' *******************
  591. '
  592. PROCEDURE load
  593.   prn$="load"
  594.   last_filename$=""
  595.   answer%=1
  596.   @check_entry
  597.   IF entry!
  598.     @bell
  599.     GET 44,68,276,132,tmp$
  600.     GRAPHMODE 1
  601.     DEFFILL 0,1,1
  602.     PBOX 44,68,276,132
  603.     COLOR 14
  604.     BOX 48,71,272,129
  605.     BOX 47,70,273,130
  606.     BOX 44,68,276,132
  607.     DEFTEXT 1,,,6
  608.     TEXT 90,87,"The Staff has entries!"
  609.     TEXT 90,95,"   Overwrite Staff?"
  610.     PUT 54,79,question$
  611.     COLOR 15
  612.     BOX 123,115,155,125
  613.     BOX 122,114,156,126
  614.     TEXT 127,123,"Yes"
  615.     BOX 163,115,195,125
  616.     BOX 162,114,196,126
  617.     TEXT 171,123,"No"
  618.     @show_mouse
  619.     answer%=0
  620.     REPEAT
  621.       MOUSE x%,y%,k%
  622.       IF x%>319
  623.         SUB x%,320
  624.       ENDIF
  625.       IF k%=1
  626.         IF x%>122 AND x%<155 AND y%>114 AND y%<125
  627.           answer%=1
  628.         ELSE
  629.           IF x%>162 AND x%<196 AND y%>114 AND y%<125
  630.             answer%=2
  631.           ENDIF
  632.         ENDIF
  633.         REPEAT
  634.         UNTIL MOUSEK=0
  635.       ENDIF
  636.     UNTIL answer%=1 OR answer%=2
  637.     PUT 44,68,tmp$
  638.   ENDIF
  639.   IF answer%=1
  640.     @get_filename("Load Data","TUN")
  641.     @ld_it
  642.   ENDIF
  643. RETURN
  644. PROCEDURE ld_it
  645.   prn$="ld_it"
  646.   last_filename$=""
  647.   IF filename$<>"" AND RIGHT$(filename$)<>"\"
  648.     IF EXIST(filename$)
  649.       temp%=new_offset%
  650.       OPEN "I",#1,filename$
  651.       last_filename$=filename$
  652.       FOR i%=0 TO max_notes%-1
  653.         IF i%>14 AND i%<max_notes%
  654.           new_offset%=i%-14
  655.           @show_note_bar
  656.         ENDIF
  657.         FOR j%=0 TO 2
  658.           FOR k%=0 TO 7
  659.             INPUT #1;vc%
  660.             voice%(j%,i%,k%)=vc%
  661.           NEXT k%
  662.         NEXT j%
  663.       NEXT i%
  664.       new_offset%=0
  665.       old_offset%=0
  666.       @show_note_bar
  667.       offset%=0
  668.       FOR i%=0 TO 14
  669.         @show_notes(i%+offset%,i%)
  670.       NEXT i%
  671.       SGET mscreen$
  672.       CLOSE #1
  673.       @show_note_bar
  674.     ELSE
  675.       IF NOT startup!
  676.         @bell
  677.         GET 76,68,244,132,tmp$
  678.         GRAPHMODE 1
  679.         DEFFILL 0,1,1
  680.         PBOX 76,68,244,132
  681.         COLOR 9
  682.         BOX 80,71,240,129
  683.         BOX 79,70,241,130
  684.         BOX 76,68,244,132
  685.         DEFTEXT 1,,,6
  686.         TEXT 122,87,"That file does"
  687.         TEXT 122,95,"  not exist!"
  688.         PUT 86,79,exclamation$
  689.         COLOR 10
  690.         BOX 148,115,172,125
  691.         BOX 147,114,173,126
  692.         TEXT 152,123,"Ok"
  693.         @show_mouse
  694.         answer%=0
  695.         REPEAT
  696.           MOUSE x%,y%,k%
  697.           IF x%>319
  698.             SUB x%,320
  699.           ENDIF
  700.           IF k%=1
  701.             IF x%>147 AND x%<172 AND y%>114 AND y%<126
  702.               answer%=1
  703.             ELSE
  704.               bell
  705.             ENDIF
  706.             REPEAT
  707.             UNTIL MOUSEK=0
  708.           ENDIF
  709.         UNTIL answer%=1
  710.         PUT 76,68,tmp$
  711.       ENDIF
  712.     ENDIF
  713.   ENDIF
  714. RETURN
  715. PROCEDURE reset
  716.   prn$="reset"
  717.   last_filename$=""
  718.   @check_entry
  719.   IF entry!
  720.     bell
  721.     GET 68,68,252,132,tmp$
  722.     GRAPHMODE 1
  723.     DEFFILL 0,1,1
  724.     PBOX 68,68,252,132
  725.     COLOR 5
  726.     BOX 72,71,248,129
  727.     BOX 71,70,249,130
  728.     BOX 68,68,252,132
  729.     DEFTEXT 1,,,6
  730.     TEXT 114,87,"Clear the Staff?"
  731.     TEXT 114,103," Are you sure?"
  732.     PUT 78,79,question$
  733.     COLOR 9
  734.     BOX 123,115,155,125
  735.     BOX 122,114,156,126
  736.     TEXT 127,123,"Yes"
  737.     BOX 163,115,195,125
  738.     BOX 162,114,196,126
  739.     TEXT 171,123,"No"
  740.     @show_mouse
  741.     answer%=0
  742.     REPEAT
  743.       MOUSE x%,y%,k%
  744.       IF x%>319
  745.         SUB x%,320
  746.       ENDIF
  747.       IF k%=1
  748.         IF x%>122 AND x%<155 AND y%>114 AND y%<125
  749.           answer%=1
  750.         ELSE
  751.           IF x%>162 AND x%<196 AND y%>114 AND y%<125
  752.             answer%=2
  753.           ENDIF
  754.         ENDIF
  755.         REPEAT
  756.         UNTIL MOUSEK=0
  757.       ENDIF
  758.     UNTIL answer%=1 OR answer%=2
  759.     PUT 68,68,tmp$
  760.     IF answer%=1
  761.       FOR i%=0 TO 14
  762.         PUT i%*19+sx1%-3,sy1%-13,blank_staff$
  763.       NEXT i%
  764.       FOR i%=0 TO max_notes%-1
  765.         FOR j%=0 TO 2
  766.           voice%(j%,i%,0)=0
  767.           voice%(j%,i%,1)=0
  768.           voice%(j%,i%,2)=0
  769.           voice%(j%,i%,3)=0
  770.           voice%(j%,i%,4)=0
  771.           voice%(j%,i%,5)=0
  772.           voice%(j%,i%,6)=0
  773.           voice%(j%,i%,7)=0
  774.         NEXT j%
  775.       NEXT i%
  776.       SGET mscreen$
  777.     ENDIF
  778.   ELSE
  779.     @no_entries
  780.   ENDIF
  781. RETURN
  782. PROCEDURE save
  783.   prn$="save"
  784.   last_filename$=""
  785.   @check_entry
  786.   IF entry!
  787.     @get_filename("Save Data","TUN")
  788.     IF filename$<>"" AND RIGHT$(filename$)<>"\"
  789.       answer%=1
  790.       IF EXIST(filename$)
  791.         @bell
  792.         GET 64,68,256,132,tmp$
  793.         GRAPHMODE 1
  794.         DEFFILL 0,1,1
  795.         PBOX 64,68,256,132
  796.         COLOR 3
  797.         BOX 68,71,252,129
  798.         BOX 67,70,253,130
  799.         BOX 64,68,256,132
  800.         DEFTEXT 1,,,6
  801.         TEXT 110,87,"That file exists!"
  802.         TEXT 110,95," Overwrite file?"
  803.         PUT 74,79,question$
  804.         COLOR 13
  805.         BOX 123,115,155,125
  806.         BOX 122,114,156,126
  807.         TEXT 127,123,"Yes"
  808.         BOX 163,115,195,125
  809.         BOX 162,114,196,126
  810.         TEXT 171,123,"No"
  811.         @show_mouse
  812.         answer%=0
  813.         REPEAT
  814.           MOUSE x%,y%,k%
  815.           IF x%>319
  816.             SUB x%,320
  817.           ENDIF
  818.           IF k%=1
  819.             IF x%>122 AND x%<155 AND y%>114 AND y%<125
  820.               answer%=1
  821.             ELSE
  822.               IF x%>162 AND x%<196 AND y%>114 AND y%<125
  823.                 answer%=2
  824.               ENDIF
  825.             ENDIF
  826.             REPEAT
  827.             UNTIL MOUSEK=0
  828.           ENDIF
  829.         UNTIL answer%=1 OR answer%=2
  830.         PUT 64,68,tmp$
  831.       ENDIF
  832.       IF answer%=1
  833.         temp%=new_offset%
  834.         OPEN "O",#1,filename$
  835.         last_filename$=filename$
  836.         FOR i%=0 TO max_notes%-1
  837.           IF i%>14
  838.             new_offset%=i%-14
  839.             @show_note_bar
  840.           ENDIF
  841.           FOR j%=0 TO 2
  842.             FOR k%=0 TO 7
  843.               vc%=voice%(j%,i%,k%)
  844.               PRINT #1;vc%
  845.             NEXT k%
  846.           NEXT j%
  847.         NEXT i%
  848.         CLOSE #1
  849.         new_offset%=temp%
  850.         @show_note_bar
  851.       ENDIF
  852.     ENDIF
  853.   ELSE
  854.     @no_entries
  855.   ENDIF
  856. RETURN
  857. PROCEDURE write
  858.   prn$="write"
  859.   last_filename$=""
  860.   @check_entry
  861.   IF entry!
  862.     @get_filename("Write GFA","LST")
  863.     IF filename$<>"" AND RIGHT$(filename$)<>"\"
  864.       temp%=new_offset%
  865.       OPEN "O",#1,filename$
  866.       last_filename$=filename$
  867.       FOR i%=0 TO max_notes%-1
  868.         IF i%>14
  869.           new_offset%=i%-14
  870.         ENDIF
  871.         savit!=FALSE
  872.         voices%=0
  873.         FOR j%=0 TO 2
  874.           IF voice%(j%,i%,0)<>0
  875.             IF j%=0
  876.               voices%=1
  877.             ELSE
  878.               IF j%=1
  879.                 ADD voices%,2
  880.               ELSE
  881.                 IF j%=2
  882.                   ADD voices%,4
  883.                 ENDIF
  884.               ENDIF
  885.             ENDIF
  886.             d%(j%)=((voice%(j%,i%,7)*spd%((voice%(j%,i%,1)-1))*0.5)+(spd%((voice%(j%,i%,1)-1)))*15/spd%)
  887.             savit!=TRUE
  888.             SOUND j%+1,0,voice%(j%,i%,3),voice%(j%,i%,2),0
  889.             PRINT #1;"SOUND ";j%+1;CHR$(44);0;CHR$(44);voice%(j%,i%,3);CHR$(44);voice%(j%,i%,2);CHR$(44);0
  890.           ELSE
  891.             d%(j%)=0
  892.           ENDIF
  893.           sd%=MAX(d%(0),d%(1))
  894.           s%=MAX(sd%,d%(2))
  895.         NEXT j%
  896.         PUT 120,45,slider_bar$
  897.         PUT INT((i%*1.23)+120),45,slider_knob$
  898.         IF savit!
  899.           PRINT #1;"WAVE ";voices%;CHR$(44);voices%;CHR$(44);13;CHR$(44);0;CHR$(44);INT(s%*0.125*1.2)
  900.           WAVE voices%,voices%,13,0,INT(s%*0.125)
  901.         ENDIF
  902.       NEXT i%
  903.       FOR j%=0 TO 2
  904.         PRINT #1;"SOUND ";j%;CHR$(44);0;CHR$(44);0;CHR$(44);0;CHR$(44);0
  905.         SOUND j%,0,0,0,0
  906.       NEXT j%
  907.       PRINT #1;"WAVE ";0;CHR$(44);0;CHR$(44);0;CHR$(44);0;CHR$(44);0
  908.       WAVE 0,0,0,0,0
  909.       CLOSE #1
  910.       new_offset%=temp%
  911.       @show_note_bar
  912.     ENDIF
  913.   ELSE
  914.     @no_entries
  915.   ENDIF
  916. RETURN
  917. PROCEDURE play
  918.   prn$="play"
  919.   last_filename$=""
  920.   @check_entry
  921.   IF entry!
  922.     temp%=new_offset%
  923.     FOR i%=0 TO max_notes%-1
  924.       sndit!=FALSE
  925.       voices%=0
  926.       FOR j%=0 TO 2
  927.         IF voice%(j%,i%,0)<>0
  928.           IF voice%(j%,i%,1)<7
  929.             IF j%=0
  930.               voices%=1
  931.             ELSE
  932.               IF j%=1
  933.                 ADD voices%,2
  934.               ELSE
  935.                 IF j%=2
  936.                   ADD voices%,4
  937.                 ENDIF
  938.               ENDIF
  939.             ENDIF
  940.           ENDIF
  941.           d%(j%)=((voice%(j%,i%,7)*spd%((voice%(j%,i%,1)-1))*0.5)+(spd%((voice%(j%,i%,1)-1)))*15/spd%)
  942.           sndit!=TRUE
  943.           SOUND j%+1,0,voice%(j%,i%,3),voice%(j%,i%,2),0
  944.         ELSE
  945.           d%(j%)=0
  946.         ENDIF
  947.         sd%=MAX(d%(0),d%(1))
  948.         s%=MAX(sd%,d%(2))
  949.       NEXT j%
  950.       new_offset%=INT(i%*49/63)
  951.       @show_note_bar
  952.       IF sndit!
  953.         WAVE voices%,voices%,13,0,INT(s%*0.125)
  954.       ENDIF
  955.     NEXT i%
  956.     new_offset%=temp%
  957.     @show_note_bar
  958.     FOR j%=0 TO 2
  959.       SOUND j%,0,0,0,0
  960.     NEXT j%
  961.     WAVE 0,0,0,0,0
  962.     PAUSE 1
  963.   ELSE
  964.     @no_entries
  965.   ENDIF
  966. RETURN
  967. PROCEDURE check_entry
  968.   prn$="check_entry"
  969.   last_filename$=""
  970.   entry!=FALSE
  971.   FOR i%=0 TO max_notes%-1
  972.     FOR j%=0 TO 2
  973.       IF voice%(j%,i%,0)<>0
  974.         entry!=TRUE
  975.       ENDIF
  976.     NEXT j%
  977.   NEXT i%
  978. RETURN
  979. '
  980. ' *******************
  981. '
  982. PROCEDURE set_speed
  983.   prn$="set_speed"
  984.   last_filename$=""
  985.   spd%=15-INT((y%-14)/2)
  986.   @show_speed_bar
  987. RETURN
  988. PROCEDURE show_speed_bar
  989.   prn$="show_speed_bar"
  990.   last_filename$=""
  991.   @hide_mouse
  992.   GRAPHMODE 1
  993.   PUT 84,13,bar$
  994.   PUT 83,41-((spd%-1)*2),knob$
  995.   DEFTEXT 1,,,4
  996.   IF spd%<10
  997.     TEXT 84,50,"0"+STR$(spd%)
  998.   ELSE
  999.     TEXT 84,50,STR$(spd%)
  1000.   ENDIF
  1001.   SGET mscreen$
  1002.   @show_mouse
  1003. RETURN
  1004. PROCEDURE set_volume
  1005.   prn$="set_volume"
  1006.   last_filename$=""
  1007.   vol%=15-INT((y%-14)/2)
  1008.   @show_volume_bar
  1009. RETURN
  1010. PROCEDURE show_volume_bar
  1011.   prn$="show_volume_bar"
  1012.   last_filename$=""
  1013.   @hide_mouse
  1014.   GRAPHMODE 1
  1015.   PUT 225,13,bar$
  1016.   PUT 224,41-((vol%-1)*2),knob$
  1017.   DEFTEXT 1,,,4
  1018.   IF vol%<10
  1019.     TEXT 225,50,"0"+STR$(vol%)
  1020.   ELSE
  1021.     TEXT 225,50,STR$(vol%)
  1022.   ENDIF
  1023.   SGET mscreen$
  1024.   @show_mouse
  1025. RETURN
  1026. PROCEDURE do_slider
  1027.   prn$="do_slider"
  1028.   last_filename$=""
  1029.   REPEAT
  1030.     MOUSE ox%,oy%,ob%
  1031.     IF ox%>319
  1032.       SUB ox%,320
  1033.     ENDIF
  1034.     IF ox%>119 AND ox%<198 AND oy%>44 AND oy%<52
  1035.       new_offset%=INT((ox%-119)/1.58)
  1036.       @show_note_bar
  1037.     ELSE
  1038.       ob%=0
  1039.     ENDIF
  1040.   UNTIL ob%=0
  1041.   IF new_offset%<>offset%
  1042.     offset%=new_offset%
  1043.     FOR i%=0 TO 14
  1044.       show_notes(i%+offset%,i%)
  1045.     NEXT i%
  1046.   ENDIF
  1047.   SGET mscreen$
  1048. RETURN
  1049. PROCEDURE move_left
  1050.   prn$="move_left"
  1051.   last_filename$=""
  1052.   IF offset%<max_notes%-15
  1053.     DEFFILL 4,1,1
  1054.     FILL 208,49
  1055.     FILL 212,49
  1056.     GET sx1%+19,sy1%-13,sx2%,sy2%+1,temp$
  1057.     PUT sx1%,sy1%-13,temp$
  1058.     INC offset%
  1059.     DEFFILL 1,1,1
  1060.     FILL 208,49
  1061.     FILL 212,49
  1062.     show_notes(14+offset%,14)
  1063.     new_offset%=offset%
  1064.     @show_note_bar
  1065.   ENDIF
  1066. RETURN
  1067. PROCEDURE move_right
  1068.   prn$="move_right"
  1069.   last_filename$=""
  1070.   IF offset%>0
  1071.     DEFFILL 4,1,1
  1072.     FILL 103,49
  1073.     FILL 106,49
  1074.     GET sx1%,sy1%-13,sx2%-17,sy2%+1,temp$
  1075.     PUT sx1%+19,sy1%-13,temp$
  1076.     DEC offset%
  1077.     DEFFILL 1,1,1
  1078.     FILL 103,49
  1079.     FILL 106,49
  1080.     show_notes(offset%,0)
  1081.     new_offset%=offset%
  1082.     @show_note_bar
  1083.   ENDIF
  1084. RETURN
  1085. PROCEDURE show_note_bar
  1086.   prn$="show_note_bar"
  1087.   last_filename$=""
  1088.   @hide_mouse
  1089.   PUT 120,45,slider_bar$
  1090.   PUT INT((new_offset%*1.58)+120),45,slider_knob$
  1091.   SGET mscreen$
  1092.   @show_mouse
  1093. RETURN
  1094. '
  1095. ' ********************
  1096. '
  1097. PROCEDURE hide_mouse
  1098.   prn$="hide_mouse"
  1099.   last_filename$=""
  1100.   IF NOT hidden!
  1101.     hidden!=TRUE
  1102.     HIDEM
  1103.   ENDIF
  1104. RETURN
  1105. PROCEDURE show_mouse
  1106.   prn$="show_mouse"
  1107.   last_filename$=""
  1108.   IF hidden!
  1109.     hidden!=FALSE
  1110.     SHOWM
  1111.   ENDIF
  1112. RETURN
  1113. '
  1114. ' ********************
  1115. '
  1116. PROCEDURE degas_load(a$)
  1117.   prn$="degas_load(a$)"
  1118.   last_filename$=""
  1119.   BLOAD a$,XBIOS(2)-34
  1120.   a%=XBIOS(2)-32
  1121.   FOR x=0 TO 15
  1122.     sa%(x)=DPEEK(a%)
  1123.     a%=a%+2
  1124.   NEXT x
  1125. RETURN
  1126. PROCEDURE set_sound_data
  1127.   prn$="set_sound_data"
  1128.   last_filename$=""
  1129.   RESTORE sound_data
  1130.   FOR i%=23 TO 0 STEP -1
  1131.     READ nt,oct
  1132.     s%(i%,0)=nt
  1133.     s%(i%,1)=oct
  1134.   NEXT i%
  1135. sound_data:
  1136.   DATA 6,2
  1137.   DATA 8,2
  1138.   DATA 10,2
  1139.   DATA 12,2
  1140.   DATA 1,3
  1141.   DATA 3,3
  1142.   DATA 5,3
  1143.   DATA 6,3
  1144.   DATA 8,3
  1145.   DATA 10,3
  1146.   DATA 12,3
  1147.   DATA 1,4
  1148.   DATA 3,4
  1149.   DATA 5,4
  1150.   DATA 6,4
  1151.   DATA 8,4
  1152.   DATA 10,4
  1153.   DATA 12,4
  1154.   DATA 1,5
  1155.   DATA 3,5
  1156.   DATA 5,5
  1157.   DATA 6,5
  1158.   DATA 8,5
  1159.   DATA 10,5
  1160. RETURN
  1161. PROCEDURE set_colors
  1162.   prn$="set_colors"
  1163.   last_filename$=""
  1164.   FOR x=0 TO 15
  1165.     a=XBIOS(7,x,sa%(x))
  1166.   NEXT x
  1167. RETURN
  1168. PROCEDURE keep_colors
  1169.   prn$="keep_colors"
  1170.   last_filename$=""
  1171.   LOCAL i%
  1172.   DEFFN getcol(n%)=XBIOS(7,n%,-1) AND &H777
  1173.   DIM keepcol%(16)
  1174.   FOR i%=1 TO 16
  1175.     keepcol%(i%)=FN getcol(i%-1)
  1176.   NEXT i%
  1177. RETURN
  1178. PROCEDURE restore_colors
  1179.   prn$="restore_colors"
  1180.   last_filename$=""
  1181.   LOCAL i%
  1182.   FOR i%=1 TO 16
  1183.     SETCOLOR i%-1,keepcol%(i%)
  1184.   NEXT i%
  1185. RETURN
  1186. '
  1187. ' ********************
  1188. '
  1189. PROCEDURE accessories
  1190.   prn$="accessories"
  1191.   last_filename$=""
  1192.   SGET ascreen$
  1193.   @fadeout
  1194.   CLS
  1195.   IF rez%=1
  1196.     VOID XBIOS(5,L:-1,L:-1,W:rez%)
  1197.   ENDIF
  1198.   MENU menu_bar$()
  1199.   ON MENU GOSUB menu_handler
  1200.   temp1%=c%(3,0)
  1201.   temp2%=c%(3,1)
  1202.   temp3%=c%(3,2)
  1203.   FOR i%=0 TO 3
  1204.     c%(3,i%)=0
  1205.   NEXT i%
  1206.   @fadein
  1207.   leave_accessories!=FALSE
  1208.   DO
  1209.     ON MENU
  1210.     EXIT IF leave_accessories!
  1211.   LOOP
  1212.   MENU KILL
  1213.   @fadeout
  1214.   IF rez%=1
  1215.     VOID XBIOS(5,L:-1,L:-1,W:0)
  1216.   ENDIF
  1217.   SPUT ascreen$
  1218.   c%(3,0)=temp1%
  1219.   c%(3,1)=temp2%
  1220.   c%(3,2)=temp3%
  1221.   @fadein
  1222. RETURN
  1223. PROCEDURE menu_handler
  1224.   prn$="menu_handler"
  1225.   last_filename$=""
  1226.   menu_option$=menu_bar$(MENU(0))
  1227.   IF menu_option$="  Tunes v1.0"
  1228.     ALERT 1," TUNES v"+version$+"|     by|Harry Sarber|  "+rev_date$,1,"Ok",void%
  1229.   ENDIF
  1230.   IF menu_option$=" Done "
  1231.     leave_accessories!=TRUE
  1232.   ENDIF
  1233.   MENU OFF
  1234. RETURN
  1235. PROCEDURE build_menu_bar
  1236.   prn$="build_menu_bar"
  1237.   last_filename$=""
  1238.   RESTORE main_list_menu_data
  1239.   FOR i%=0 TO 50
  1240.     READ menu_bar$(i%)
  1241.     EXIT IF menu_bar$(i%)="***"
  1242.   NEXT i%
  1243.   menu_bar$(i%)=""
  1244. main_list_menu_data:
  1245.   DATA Desk,"  Tunes v1.0"
  1246.   DATA -------------------
  1247.   DATA 1,2,3,4,5,6,""
  1248.   DATA Exit, Done ,""
  1249.   DATA ***
  1250. RETURN
  1251. '
  1252. ' ********************
  1253. '
  1254. PROCEDURE quit
  1255.   prn$="quit"
  1256.   last_filename$=""
  1257.   bell
  1258.   GRAPHMODE 2
  1259.   GET 64,68,256,132,tmp$
  1260.   DEFFILL 0,1,1
  1261.   PBOX 64,68,256,132
  1262.   DEFFILL 3
  1263.   COLOR 10
  1264.   BOX 68,71,252,129
  1265.   BOX 67,70,253,130
  1266.   BOX 64,68,256,132
  1267.   DEFTEXT 1,,,6
  1268.   TEXT 110,87,"      Quit?"
  1269.   TEXT 110,103,"  Are you sure?  "
  1270.   PUT 74,79,question$
  1271.   COLOR 13
  1272.   BOX 123,115,155,125
  1273.   BOX 122,114,156,126
  1274.   TEXT 127,123,"Yes"
  1275.   BOX 163,115,195,125
  1276.   BOX 162,114,196,126
  1277.   TEXT 171,123,"No"
  1278.   @show_mouse
  1279.   answer%=0
  1280.   REPEAT
  1281.     MOUSE x%,y%,k%
  1282.     IF x%>319
  1283.       SUB x%,320
  1284.     ENDIF
  1285.     IF k%=1
  1286.       IF x%>122 AND x%<155 AND y%>114 AND y%<125
  1287.         @gone
  1288.       ELSE
  1289.         IF x%>162 AND x%<196 AND y%>114 AND y%<125
  1290.           answer%=2
  1291.         ENDIF
  1292.       ENDIF
  1293.       REPEAT
  1294.       UNTIL MOUSEK=0
  1295.     ENDIF
  1296.   UNTIL answer%=2
  1297.   PUT 64,68,tmp$
  1298. RETURN
  1299. '
  1300. ' ********************
  1301. '
  1302. PROCEDURE bell
  1303.   prn$="bell"
  1304.   last_filename$=""
  1305.   PRINT AT(1,1);CHR$(7)
  1306. RETURN
  1307. PROCEDURE no_entries
  1308.   prn$="no_entries"
  1309.   last_filename$=""
  1310.   bell
  1311.   GET 48,68,272,132,tmp$
  1312.   GRAPHMODE 1
  1313.   DEFFILL 0,1,1
  1314.   PBOX 48,68,272,132
  1315.   COLOR 13
  1316.   BOX 52,71,268,129
  1317.   BOX 51,70,269,130
  1318.   BOX 48,68,272,132
  1319.   DEFTEXT 1,,,6
  1320.   TEXT 94,95,"There are no entries!"
  1321.   PUT 58,79,stopsign$
  1322.   COLOR 6
  1323.   BOX 148,115,172,125
  1324.   BOX 147,114,173,126
  1325.   TEXT 152,123,"Ok"
  1326.   @show_mouse
  1327.   answer%=0
  1328.   REPEAT
  1329.     MOUSE x%,y%,k%
  1330.     IF x%>319
  1331.       SUB x%,320
  1332.     ENDIF
  1333.     IF k%=1
  1334.       IF x%>147 AND x%<172 AND y%>114 AND y%<126
  1335.         answer%=1
  1336.       ELSE
  1337.         bell
  1338.       ENDIF
  1339.       REPEAT
  1340.       UNTIL MOUSEK=0
  1341.     ENDIF
  1342.   UNTIL answer%=1
  1343.   PUT 48,68,tmp$
  1344. RETURN
  1345. PROCEDURE fadein
  1346.   FOR j%=1 TO rate%                     ! Fade-In Loop
  1347.     percent=j%/rate%
  1348.     FOR i%=0 TO 15
  1349.       SETCOLOR i%,c%(i%,0)*percent,c%(i%,1)*percent,c%(i%,2)*percent
  1350.     NEXT i%
  1351.   NEXT j%
  1352. RETURN
  1353. PROCEDURE fadeout
  1354.   FOR j%=rate% TO 1 STEP -1                     ! Fade-In Loop
  1355.     percent=j%/rate%
  1356.     FOR i%=0 TO 15
  1357.       SETCOLOR i%,c%(i%,0)*percent,c%(i%,1)*percent,c%(i%,2)*percent
  1358.     NEXT i%
  1359.   NEXT j%
  1360. RETURN
  1361. PROCEDURE get_filename(t$,e$)
  1362.   prn$="get_filename(t$,e$)"
  1363.   last_filename$=""
  1364.   @hide_mouse
  1365.   SGET fscreen$
  1366.   @fadeout
  1367.   CLS
  1368.   IF rez%=1                             ! Reset to medium rez if necessary.
  1369.     VOID XBIOS(5,L:-1,L:-1,W:rez%)
  1370.   ENDIF
  1371.   temp1%=c%(3,0)
  1372.   temp2%=c%(3,1)
  1373.   temp3%=c%(3,2)
  1374.   FOR i%=0 TO 3
  1375.     c%(3,i%)=0
  1376.   NEXT i%
  1377.   @fadein
  1378.   path_name$=SPACE$(64)                     ! Reserve space for path name
  1379.   drive%=GEMDOS(&H19)                       ! Get drive number
  1380.   ptr%=VARPTR(path_name$)                   ! Define pointer to variable
  1381.   VOID GEMDOS(&H47,L:ptr%,W:drive%+1)
  1382.   FOR i%=1 TO 63
  1383.     IF ASC(MID$(path_name$,i%,1))=0
  1384.       path_name$=LEFT$(path_name$,i%-1)
  1385.       i%=63
  1386.     ENDIF
  1387.   NEXT i%
  1388.   PRINT AT(1,1);t$
  1389.   d$=data_path$+"*."+e$ ! Path to search
  1390.   @show_mouse
  1391.   FILESELECT d$,b$,filename$                 ! Get a filename
  1392.   b%=RINSTR(filename$,"\")
  1393.   path$=LEFT$(filename$,b%)
  1394.   file$=MID$(filename$,b%+1)
  1395.   @fadeout
  1396.   c%(3,0)=temp1%
  1397.   c%(3,1)=temp2%
  1398.   c%(3,2)=temp3%
  1399.   IF rez%=1
  1400.     VOID XBIOS(5,L:-1,L:-1,W:0)
  1401.   ENDIF
  1402.   SPUT fscreen$
  1403.   @fadein
  1404. RETURN
  1405. PROCEDURE err_handler
  1406.   CLOSE #1
  1407.   GRAPHMODE 1
  1408.   FOR i%=1 TO 3
  1409.     PRINT AT(1,1);CHR$(7)
  1410.     PAUSE 15
  1411.   NEXT i%
  1412.   DEFFILL 0,1,1
  1413.   GET 12,68,308,132,tmp$
  1414.   PBOX 12,68,308,132
  1415.   COLOR 3
  1416.   BOX 16,71,304,129
  1417.   BOX 15,70,305,130
  1418.   BOX 12,68,308,132
  1419.   DEFTEXT 1,,,6
  1420.   TEXT 58,79,"Error #"+STR$(ERR)+" has occurred!"
  1421.   TEXT 58,87,"Procedure: "+prn$
  1422.   TEXT 58,95,"Filename:"
  1423.   TEXT 58,103,last_filename$
  1424.   PUT 22,79,stopsign$
  1425.   COLOR 15
  1426.   BOX 140,115,180,125
  1427.   BOX 139,114,181,126
  1428.   TEXT 144,123," Ok "
  1429.   @show_mouse
  1430.   DO
  1431.     MOUSE x%,y%,k%
  1432.     IF x%>319
  1433.       SUB x%,320
  1434.     ENDIF
  1435.     IF k%=1
  1436.       IF x%>138 AND x%<182 AND y%>113 AND y%<127
  1437.         PUT 12,68,tmp$
  1438.         REPEAT
  1439.         UNTIL MOUSEK=0
  1440.         @check_entry
  1441.         IF entry!
  1442.           GRAPHMODE 1
  1443.           DEFFILL 0,1,1
  1444.           GET 64,68,256,132,tmp$
  1445.           PBOX 64,68,256,132
  1446.           COLOR 3
  1447.           BOX 68,71,252,129
  1448.           BOX 67,70,253,130
  1449.           BOX 64,68,256,132
  1450.           DEFTEXT 1,,,6
  1451.           TEXT 110,87,"Try to save data?"
  1452.           PUT 74,79,question$
  1453.           COLOR 2
  1454.           BOX 123,115,155,125
  1455.           BOX 122,114,156,126
  1456.           TEXT 127,123,"Yes"
  1457.           BOX 163,115,195,125
  1458.           BOX 162,114,196,126
  1459.           TEXT 171,123,"No"
  1460.           DO
  1461.             MOUSE x%,y%,k%
  1462.             IF x%>319
  1463.               SUB x%,320
  1464.             ENDIF
  1465.             IF k%=1
  1466.               IF x%>121 AND x%<157 AND y%>113 AND y%<127
  1467.                 PUT 64,68,tmp$
  1468.                 @save
  1469.                 @gone
  1470.               ELSE
  1471.                 IF x%>161 AND x%<197 AND y%>113 AND y%<127
  1472.                   PUT 64,68,tmp$
  1473.                   @gone
  1474.                 ELSE
  1475.                   @bell
  1476.                 ENDIF
  1477.               ENDIF
  1478.             ENDIF
  1479.           LOOP
  1480.         ENDIF
  1481.         @gone
  1482.       ELSE
  1483.         @bell
  1484.       ENDIF
  1485.     ENDIF
  1486.   LOOP
  1487. RETURN
  1488. '
  1489. ' ***********************
  1490. '
  1491. PROCEDURE exclamation
  1492.   RESTORE exclamation_data
  1493.   exclamation$=SPACE$(518)
  1494.   FOR i%=0 TO 516 STEP 2
  1495.     READ pd
  1496.     DPOKE VARPTR(exclamation$)+i%,pd
  1497.   NEXT i%
  1498. exclamation_data:
  1499.   DATA 31,31,4,3,3,3,3,49152
  1500.   DATA 49152,49152,49152,6,6,6,6,24576
  1501.   DATA 24576,24576,24576,13,13,13,13,45056
  1502.   DATA 45056,45056,45056,27,27,27,27,55296
  1503.   DATA 55296,55296,55296,55,55,55,55,60416
  1504.   DATA 60416,60416,60416,111,111,111,111,62976
  1505.   DATA 62976,62976,62976,220,220,220,220,15104
  1506.   DATA 15104,15104,15104,444,444,444,444,15744
  1507.   DATA 15744,15744,15744,892,892,892,892,16064
  1508.   DATA 16064,16064,16064,1788,1788,1788,1788,16224
  1509.   DATA 16224,16224,16224,3580,3580,3580,3580,16304
  1510.   DATA 16304,16304,16304,7164,7164,7164,7164,16344
  1511.   DATA 16344,16344,16344,14332,14332,14332,14332,16364
  1512.   DATA 16364,16364,16364,28668,28668,28668,28668,16374
  1513.   DATA 16374,16374,16374,57340,57340,57340,57340,16379
  1514.   DATA 16379,16379,16379,49148,49148,49148,49148,16381
  1515.   DATA 16381,16381,16381,49148,49148,49148,49148,16381
  1516.   DATA 16381,16381,16381,57340,57340,57340,57340,16379
  1517.   DATA 16379,16379,16379,28668,28668,28668,28668,16374
  1518.   DATA 16374,16374,16374,14332,14332,14332,14332,16364
  1519.   DATA 16364,16364,16364,7167,7167,7167,7167,65496
  1520.   DATA 65496,65496,65496,3583,3583,3583,3583,65456
  1521.   DATA 65456,65456,65456,1788,1788,1788,1788,16224
  1522.   DATA 16224,16224,16224,892,892,892,892,16064
  1523.   DATA 16064,16064,16064,444,444,444,444,15744
  1524.   DATA 15744,15744,15744,220,220,220,220,15104
  1525.   DATA 15104,15104,15104,111,111,111,111,62976
  1526.   DATA 62976,62976,62976,55,55,55,55,60416
  1527.   DATA 60416,60416,60416,27,27,27,27,55296
  1528.   DATA 55296,55296,55296,13,13,13,13,45056
  1529.   DATA 45056,45056,45056,6,6,6,6,24576
  1530.   DATA 24576,24576,24576,3,3,3,3,49152
  1531.   DATA 49152,49152,49152
  1532. RETURN
  1533. PROCEDURE question
  1534.   RESTORE question_data
  1535.   question$=SPACE$(518)
  1536.   FOR i%=0 TO 516 STEP 2
  1537.     READ pd
  1538.     DPOKE VARPTR(question$)+i%,pd
  1539.   NEXT i%
  1540. question_data:
  1541.   DATA 31,31,4,16383,16383,16383,16383,65532
  1542.   DATA 65532,65532,65532,49152,49152,49152,49152,3
  1543.   DATA 3,3,3,40959,40959,40959,40959,65529
  1544.   DATA 65529,65529,65529,49151,49151,49151,49151,65533
  1545.   DATA 65533,65533,65533,57336,57336,57336,57336,16379
  1546.   DATA 16379,16379,16379,24544,24544,24544,24544,4090
  1547.   DATA 4090,4090,4090,28608,28608,28608,28608,2038
  1548.   DATA 2038,2038,2038,12163,12163,12163,12163,33780
  1549.   DATA 33780,33780,33780,14215,14215,14215,14215,50156
  1550.   DATA 50156,50156,50156,6023,6023,6023,6023,50152
  1551.   DATA 50152,50152,50152,7167,7167,7167,7167,33752
  1552.   DATA 33752,33752,33752,3071,3071,3071,3071,2000
  1553.   DATA 2000,2000,2000,3582,3582,3582,3582,4016
  1554.   DATA 4016,4016,4016,1532,1532,1532,1532,8096
  1555.   DATA 8096,8096,8096,1788,1788,1788,1788,16224
  1556.   DATA 16224,16224,16224,764,764,764,764,16192
  1557.   DATA 16192,16192,16192,892,892,892,892,16064
  1558.   DATA 16064,16064,16064,380,380,380,380,16000
  1559.   DATA 16000,16000,16000,447,447,447,447,64896
  1560.   DATA 64896,64896,64896,191,191,191,191,64768
  1561.   DATA 64768,64768,64768,220,220,220,220,15104
  1562.   DATA 15104,15104,15104,92,92,92,92,14848
  1563.   DATA 14848,14848,14848,108,108,108,108,13824
  1564.   DATA 13824,13824,13824,47,47,47,47,62464
  1565.   DATA 62464,62464,62464,55,55,55,55,60416
  1566.   DATA 60416,60416,60416,23,23,23,23,59392
  1567.   DATA 59392,59392,59392,27,27,27,27,55296
  1568.   DATA 55296,55296,55296,11,11,11,11,53248
  1569.   DATA 53248,53248,53248,13,13,13,13,45056
  1570.   DATA 45056,45056,45056,5,5,5,5,40960
  1571.   DATA 40960,40960,40960,6,6,6,6,24576
  1572.   DATA 24576,24576,24576,3,3,3,3,49152
  1573.   DATA 49152,49152,49152
  1574. RETURN
  1575. PROCEDURE stopsign
  1576.   RESTORE stopsign_data
  1577.   stopsign$=SPACE$(518)
  1578.   FOR i%=0 TO 516 STEP 2
  1579.     READ pd
  1580.     DPOKE VARPTR(stopsign$)+i%,pd
  1581.   NEXT i%
  1582. stopsign_data:
  1583.   DATA 31,31,4,127,127,127,127,65024
  1584.   DATA 65024,65024,65024,192,192,192,192,768
  1585.   DATA 768,768,768,447,447,447,447,64896
  1586.   DATA 64896,64896,64896,895,895,895,895,65216
  1587.   DATA 65216,65216,65216,1791,1791,1791,1791,65376
  1588.   DATA 65376,65376,65376,3583,3583,3583,3583,65456
  1589.   DATA 65456,65456,65456,7167,7167,7167,7167,65496
  1590.   DATA 65496,65496,65496,14335,14335,14335,14335,65516
  1591.   DATA 65516,65516,65516,28671,28671,28671,28671,65526
  1592.   DATA 65526,65526,65526,57343,57343,57343,57343,65531
  1593.   DATA 65531,65531,65531,45441,45441,45441,45441,34317
  1594.   DATA 34317,34317,34317,41089,41089,41089,41089,517
  1595.   DATA 517,517,517,42215,42215,42215,42215,12901
  1596.   DATA 12901,12901,12901,42983,42983,42983,42983,12901
  1597.   DATA 12901,12901,12901,41959,41959,41959,41959,12901
  1598.   DATA 12901,12901,12901,45543,45543,45543,45543,12805
  1599.   DATA 12805,12805,12805,47335,47335,47335,47335,12813
  1600.   DATA 12813,12813,12813,48359,48359,48359,48359,12925
  1601.   DATA 12925,12925,12925,42215,42215,42215,42215,12925
  1602.   DATA 12925,12925,12925,41191,41191,41191,41191,637
  1603.   DATA 637,637,637,45543,45543,45543,45543,34429
  1604.   DATA 34429,34429,34429,49151,49151,49151,49151,65533
  1605.   DATA 65533,65533,65533,57343,57343,57343,57343,65531
  1606.   DATA 65531,65531,65531,28671,28671,28671,28671,65526
  1607.   DATA 65526,65526,65526,14335,14335,14335,14335,65516
  1608.   DATA 65516,65516,65516,7167,7167,7167,7167,65496
  1609.   DATA 65496,65496,65496,3583,3583,3583,3583,65456
  1610.   DATA 65456,65456,65456,1791,1791,1791,1791,65376
  1611.   DATA 65376,65376,65376,895,895,895,895,65216
  1612.   DATA 65216,65216,65216,447,447,447,447,64896
  1613.   DATA 64896,64896,64896,192,192,192,192,768
  1614.   DATA 768,768,768,127,127,127,127,65024
  1615.   DATA 65024,65024,65024
  1616. RETURN
  1617.